unit WideStringList;

interface

uses Windows, SysUtils, Classes;

type
  PStringItemW = ^TStringItemW;
  TStringItemW = record
    FString: WideString;
    FObject: TObject;
  end;

  TSaveEncoding = (cpASCII, cpUCS2, cpUTF8);

  TWideStringList = class(TObject)
  private
    FItems: TList;
    FKVSplit: WideChar;
    function Get(Index: Integer): WideString;
    procedure Put(Index: Integer; const Value: WideString);
    function RGetCount: integer;
    function RGetKey(index: integer): WideString;
    function RGetText: WideString;
    function RGetVal(Key: WideString): WideString;
    function RGetValI(index: integer): WideString;
    procedure RSetKey(index: integer; const Value: WideString);
    procedure RSetText(const Value: WideString);
    procedure RSetVal(Key: WideString; const Value: WideString);
    procedure RSetValI(index: integer; const Value: WideString);
    function RGetObj(index: integer): TObject;
    procedure RSetObj(index: integer; const Value: TObject);
  protected
    function KeyOf(ws: WideString): WideString;
    function ValueOf(ws: WideString): WideString;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Load(Filename: WideString);
    procedure Save(Filename: WideString; Enc: TSaveEncoding = cpUCS2);

    procedure Assign(Source: TObject);

    function Add(Value: WideString; Obj: TObject = nil): integer;
    procedure Delete(Index: integer);
    procedure Clear;
    property Count: integer read RGetCount;

    function IndexOf(Seek: WideString; CaseSensitive: boolean = true): integer;

    property Keys[index: integer]: WideString read RGetKey write RSetKey;
    property Values[Key: WideString]: WideString read RGetVal write RSetVal;
    property ValueFromIndex[index: integer]: WideString read RGetValI write RSetValI;

    property Text: WideString read RGetText write RSetText;
    property Strings[Index: Integer]: WideString read Get write Put; default;
    property Objects[index: integer]: TObject read RGetObj write RSetObj;
  end;

implementation

uses WideStrUtils;

procedure ShowMessage(s: string);
begin
  Windows.MessageBox(0, PChar(s), 'libcue.dll', MB_OK)
end;

function OpenFile(const ALongFileName: WideString; SharingMode: DWORD = FILE_SHARE_READ): THandle;  overload;
begin
  if CompareMem(@(WideCharToString(PWideChar(ALongFileName))[1]), @('\\'[1]), 2) then
    { Already an UNC path }
    Result := CreateFileW(PWideChar(ALongFileName), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar('\\?\' + ALongFileName), GENERIC_READ, SharingMode, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;

function MakeFile(const ALongFileName: WideString): THandle;  overload;
begin
  if CompareMem(@(WideCharToString(PWideChar(ALongFileName))[1]), @('\\'[1]), 2) then
    { Already an UNC path }
    Result := CreateFileW(PWideChar(ALongFileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
  else
    Result := CreateFileW(PWideChar('\\?\' + ALongFileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;

procedure WriteWideString(const ws: WideString; stream: TStream);
var
  nChars: LongInt;
begin
  nChars := Length(ws);
  stream.WriteBuffer(nChars, SizeOf(nChars));
  if nChars > 0 then
    stream.WriteBuffer(ws[1], nChars * SizeOf(ws[1]));
end;

function ReadWideString(stream: TStream): WideString;
var
  nChars: LongInt;
begin
  //stream.ReadBuffer(nChars, SizeOf(nChars));
  SetLength(Result, stream.size);
  if nChars > 0 then
    stream.ReadBuffer(Result[1], nChars * SizeOf(Result[1]));
end;

{ TWideStringList }

function TWideStringList.Add(Value: WideString; Obj: TObject): integer;
var pss: PStringItemW;
begin
  new(pss);
  pss^.FString := Value;
  pss^.FObject := Obj;
  FItems.Add(pss);
end;

procedure TWideStringList.Assign(Source: TObject);
var i: integer;
begin
  if Source=nil then exit;

  if (Source is TWideStringList) then begin
    Clear;
    for i := 0 to TWideStringList(Source).Count-1 do
      Add(TWideStringList(Source)[i], TWideStringList(Source).Objects[i]);
  end else
  if (Source is TStrings) then begin
    Clear;
    for i := 0 to TStrings(Source).Count-1 do
      Add(TStrings(Source)[i], TStrings(Source).Objects[i]);
  end else
    raise Exception.CreateFmt('Cannot assign %s to %s!',[Source.ClassName,Self.ClassName]);
end;

procedure TWideStringList.Clear;
begin
  while FItems.Count > 0 do Self.Delete(0);
end;

constructor TWideStringList.Create;
begin
  FItems := TList.Create;
  FKVSplit := WideChar('=');
end;

procedure TWideStringList.Delete(Index: integer);
begin
  FItems[Index] := nil;
  FItems.Delete(index);
end;

destructor TWideStringList.Destroy;
begin
  Self.Clear;
  FItems.Free;
  inherited;
end;

function TWideStringList.Get(Index: Integer): WideString;
begin
  Result := PStringItemW(FItems[index])^.FString;
end;

function TWideStringList.IndexOf(Seek: WideString;
  CaseSensitive: boolean): integer;
begin

end;

function TWideStringList.KeyOf(ws: WideString): WideString;
var x: integer;
begin
  Result := '';
  x := AnsiPos(Self.FKVSplit, ws);
  if x > 0 then
    Result := Copy(ws,1,x-SizeOf(WideChar));
end;

procedure TWideStringList.Load(Filename: WideString);
var fh: THandle;
    st: THandleStream;
    s: String;
    rea: dword;
    buf: PChar;
begin
  s := '';
  fh := OpenFile(Filename);
  if fh <> INVALID_HANDLE_VALUE then begin
    st := THandleStream.Create(fh);
    SetLength(s, st.Size);
    ReadFile(fh, s[1], st.Size, rea, nil);
    st.Free;
    CloseHandle(fh);

    if IsUTF8String(s) then
      Self.Text := UTF8Decode(s)
    else begin
      // Unicode or ASCII?
      if ((s[1] = #$FF) and (s[2] = #$FE)){ or
         ((s[1] = #$FE) and (s[2] = #$FF))} then begin

        // UCS-2 LE/BE
        buf := StrAlloc(Length(s)+1);
        UnicodeToUTF8(buf, PWideChar(s), Length(s));
        s := buf;
        StrDispose(buf);

        // Delete UTF-8 BOM if exists
        if Copy(s,1,3) = WideStrUtils.sUTF8BOMString then
          system.Delete(s,1,3);
        // Load it!
        Self.Text := UTF8Decode(s);
      end else
        Self.Text := s;//UTF8Decode(AnsiToUTF8(s));
    end;
  end;
end;

procedure TWideStringList.Put(Index: Integer; const Value: WideString);
begin
  PStringItemW(FItems[index])^.FString := Value; 
end;

function TWideStringList.RGetCount: integer;
begin
  Result := FItems.Count;
end;

function TWideStringList.RGetKey(index: integer): WideString;
begin
  Result := Self.KeyOf(PStringItemW(FItems[index])^.FString);
end;

function TWideStringList.RGetObj(index: integer): TObject;
begin
  Result := PStringItemW(FItems[index])^.FObject;
end;

function TWideStringList.RGetText: WideString;
var i: integer;
begin
  Result := '';
  for i := 0 to FItems.Count-1 do
    Result := Result+PStringItemW(FItems[i])^.FString+#13#10;
end;

function TWideStringList.RGetVal(Key: WideString): WideString;
begin

end;

function TWideStringList.RGetValI(index: integer): WideString;
begin
  Result := Self.ValueOf(PStringItemW(FItems[index])^.FString);
end;

procedure TWideStringList.RSetKey(index: integer; const Value: WideString);
begin

end;

procedure TWideStringList.RSetObj(index: integer; const Value: TObject);
begin
  PStringItemW(FItems[index])^.FObject := Value;
end;

procedure TWideStringList.RSetText(const Value: WideString);
var
  P, Start: PWideChar;
  S: WideString;
begin
  try
    Clear;
    P := Pointer(Value);
    if P <> nil then
      while P^ <> #0 do begin
        Start := P;
        while not (P^ in [WideChar(#0), WideChar(#10), WideChar(#13)]) do Inc(P);
        SetString(S, Start, P - Start);
        Add(S);
        if P^ = #13 then Inc(P);
        if P^ = #10 then Inc(P);
      end;
  finally
  end;
end;

procedure TWideStringList.RSetVal(Key: WideString;
  const Value: WideString);
begin

end;

procedure TWideStringList.RSetValI(index: integer;
  const Value: WideString);
begin

end;

const
  UTF16BE = #$FF+#$FE;
  
procedure TWideStringList.Save(Filename: WideString; Enc: TSaveEncoding);
var fh: THandle;
    wrt: dword;
    ws: WideString;
    s: string;
begin
  fh := MakeFile(Filename);
  if fh <> INVALID_HANDLE_VALUE then begin
    if Enc = cpUCS2 then begin
      ws := Self.Text;
      WriteFile(fh, UTF16BE, Length(UTF16BE), wrt, nil);
      WriteFile(fh, ws[1], Length(ws)*SizeOf(ws[1]), wrt, nil);
    end else
    if Enc = cpUTF8 then begin
      s := UTF8Encode(Self.Text);
      WriteFile(fh, s[1], Length(s), wrt, nil);
    end else begin
      s := Self.Text;
      WriteFile(fh, s[1], Length(s), wrt, nil);
    end;
    CloseHandle(fh);
  end;
end;

function TWideStringList.ValueOf(ws: WideString): WideString;
begin

end;

end.